perm filename READIN.F4[OLD,LCS] blob sn#267294 filedate 1977-03-07 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE READIN(SOURCE,QUANT,XOUT,LSIZE,FOOGY)
C00008 ENDMK
C⊗;
	SUBROUTINE READIN(SOURCE,QUANT,XOUT,LSIZE,FOOGY)
C   UNIT GEN. 'READ' = - READ(SOURCE,QUANT,ARRAY,INPUT NCHNS);
C	OUTPUTS ARE RDA, RDB, RDC AND RDD. DON'T USE U1, ETC.
C   IF SOURCE<100 IT =4TH LETTER.  E.G. 4 WILL READ FROM MUSDA (4=D)
C   IF SOURCE>100, LAST 2 DIGITS ARE LAST LETTER, 1ST 2 ARE 4TH LETTER.
C     E.G. 312 WILL READ FROM MUSCL (3=C, 12=L).   1213 = MUSLM
C   LOAD AFTER MUSY,MUSIO,NSCTPY
C   MUSIO SHOULD INCLUDE MTA1 CALLS.

	COMMON ISAVE
	DIMENSION IOUT(2128),XOUT(512),IX(128),IH(5)
	DATA IH(1)/'  REA'/,IH(2)/'DING '/,IH(4)/' / '/
	EQUIVALENCE(IOUT(2001),IX),(K,IH(5))
	IF(FOOGY)GO TO 1
C  FOOGY>-1 MEANS FIRST TIME THROUGH.
	KSIZE=LSIZE/2
C  KSIZE IS NUM OF 36-BIT WORDS TO PROCESS.
	NAME='MUSAA'
	JMP=-1
	ISAVE=-1
	MTA=0
	JA=1
	JNM='AAAAA'
	K=QUANT-1.
	JC=0
	IF(SOURCE.LT.100.)GO TO 4
	NAME=SOURCE/100.
C  GETS # FOR 1ST LETTER.
	JC=SOURCE-NAME*100
	IF(JC.NE.0)JC=JC-1
C  GETS 2ND LETTER.
	JNM=NAME-1
	GO TO 10
4	IF(SOURCE.GT.0)GO TO 2
	MTA=-1
	JNM=NAME
	CALL MTA1
	GO TO 3
2	JNM=SOURCE-1.
10	JNM='MUSAA'+256*JNM
3	KNM=JNM
	NAME=JNM+JC*2
	JC=K*2
	NM2=NAME+JC
	JADD=JNM+52-NAME
	IF(JC.GT.JADD)NM2=JNM+256+JC-JADD
C  IF NAME GOES FROM AZ TO BA
712	IF(NM2.GT.JNM+306)NM2=JNM+512+JC-52-JADD
C  IF NAME GOES FROM AZ TO CA
CC	IF(K.GT.26)NM2=NAME+256+(K-26)*2
C  AMPL. WILL BE NEG. IF LSBUF WAS NOT FULL (LAST BUFFER).
710	IF(MTA)GO TO 811
711	CALL GETFI2(NAME)
	IH(3)=NAME
	CALL MESS(IH)
	GO TO 810
811	CALL INMTA1(IX(1),128)
	IH(3)=IX(3)
	CALL MESS(IH)
	MCNT=0
C  MCNT COUNTS RECORDS READ ON MTA1
	ISAVE=-1
	IF(IX(1))GO TO 1201
C  IF NEG., IT'S THE END OF THE TAPE.
	GO TO 2022
810	CALL FASTI2(IX(1),128)
	KCNT=2
2022	JSC=IX(1)
	JADD=JSC/128
	IF(JSC-JADD*128.NE.0)JADD=JADD+1
C  JADD IS # OF 128 WD. RECORDS READ.
1022	IF(JA.GT.KSIZE)GO TO 17
610	IF(MTA)GO TO 611
	CALL FASTI2(IOUT(JA),JSC)
	KCNT=KCNT+JADD
	GO TO 612
C   LAST WORD IS THROWN AWAY.
611	IF(ISAVE.NE.-2)GO TO 614
	CALL MTA1
	CALL INMTA1(IX(1),128)
	DO 6141 K=1,MCNT
6141	CALL INMTA1(IOUT(JA),JSC)
	ISAVE=-1
	GO TO 612
C  REREADS TAPE UP TO THE RIGHT SPOT.
614	CALL INMTA1(IOUT(JA),JSC)
	MCNT=MCNT+1
612	JA=JA+JSC-1
	JC=IOUT(JA)
	IF(JC)5,1022,6
5	JA=JA-IOUT(JA-1)
6	NAME=NAME+2
	IF(NAME.LE.JNM+50)GO TO 27
	JNM=JNM+256
C   RAISES 'AAAZA' TO 'AABAA'
1017	NAME=JNM
27	IF(NAME.LE.NM2)GO TO 710
1201	NM2=NAME-1
17	CALL ZBIT(IOUT,XOUT)
9	RETURN
1	IF(ISAVE)GO TO 171
	ISAVE=-1
	IF(NAME.GT.NM2)GO TO 171
	IF(MTA.EQ.0)GO TO 271
	ISAVE=-2
	GO TO 171
C    USE 'TAPNEW' TO 'RESET' TAPE.
271	CALL GETFI2(NAME)
	CALL USETI(KCNT)
C  REREADS KCNT RECORDS OF 128 WDS.
171	JC=JA-1
	IF(JMP)7,8,9
7	JC=JC-KSIZE
	DO 12 K=1,JC
12	IOUT(K)=IOUT(K+KSIZE)
	JA=JC+1
	IF(JC.GT.KSIZE)GO TO 17
	IF(NAME.LE.NM2)GO TO 610
43	DO 13 K=JC+1,KSIZE
13	IOUT(K)=0
	JMP=0
	GO TO 17
8 	DO 14 K=1,KSIZE
14	IOUT(K)=0
	JMP=1
	GO TO 17
	END
CC 
CC 
CC NCHNS←2;SRATE←25000;
CC COMPILE;INSTRUMENT XX;
CC READ(P3,P4,F1,P5);OUTA←OUTA+RDB;<CHAN2 DATA IS PUT IN BOTH CHANS.
CC OUTB←OUTB+RDB*P6;END;FINISH;
CC BIGBIT←2;
CC PLAY;XX 0 3 4 3 2 2;FINISH;< MULTS SAMPLES BY 2 IN CH2, READS MUSDA, STEREO
CC  DO FILE FOLLOWS:
CC	LOA %DMUSY,NSCTPY,READIN,MUSIO↔C 14↔S↔DSK:NOTEY↔